Delphi 5 for Professionals/DELPHI5.iso/AddOns/Components/Orpheus v3.02/SETUP.EXE/%MAINDIR%/OvcDbDat.pas

Pascal/Delphi Source File | 1999-02-25 | 15.7 KB | 629 lines

{*********************************************************}
{*                  OVCDBDAT.PAS 3.00                    *}
{*     Copyright (c) 1995-99 TurboPower Software Co      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$I OVC.INC}

{$B-} {Complete Boolean Evaluation}
{$I+} {Input/Output-Checking}
{$P+} {Open Parameters}
{$T-} {Typed @ Operator}
{$W-} {Windows Stack Frame}
{$X+} {Extended Syntax}

{$IFNDEF Win32}
{$G+} {286 Instructions}
{$N+} {Numeric Coprocessor}

{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
{$ENDIF}

unit OvcDbDat;
  {-Data aware date edit field w/ popup calendar}

interface

uses
  {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Classes, Controls, Db, DbConsts, DbCtrls, {$IFNDEF VERSION3} DbTables, {$ENDIF}
  Forms, Graphics,
  Menus, Messages, StdCtrls, SysUtils,
  OvcBase, OvcCal, OvcEdCal, OvcEdPop, OvcEditF;

type
  TOvcCustomDbDateEdit = class(TOvcCustomDateEdit)
  {.Z+}
  protected {private}
    FAlignment    : TAlignment;
    FAutoUpdate   : Boolean;
    FCanvas       : TControlCanvas;
    FDataLink     : TFieldDataLink;
    FFocused      : Boolean;
    FPreserveTime : Boolean;

    {property methods}
    function GetDataField : string;
    function GetDataSource : TDataSource;
    function GetField : TField;
    function GetReadOnly : Boolean;
    procedure SetDataField(const Value : string);
    procedure SetDataSource(Value : TDataSource);
    procedure SetFocused(Value : Boolean);
    procedure SetReadOnly(Value : Boolean);

    {internal methods}
    procedure DataChange(Sender : TObject);
    procedure EditingChange(Sender : TObject);
    function  GetTextMargins : TPoint;
    procedure UpdateData(Sender : TObject);

    {message methods}
    procedure WMCut(var Message : TMessage);
      message WM_CUT;
    procedure WMPaste(var Message : TMessage);
      message WM_PASTE;
    procedure WMPaint(var Message : TWMPaint);
      message WM_PAINT;
    procedure CMEnter(var Message : TCMEnter);
      message CM_ENTER;
    procedure CMExit(var Message : TCMExit);
      message CM_EXIT;
    {$IFDEF Win32}
    procedure CMGetDataLink(var Message : TMessage);
      message CM_GETDATALINK;
    {$ENDIF Win32}

  protected
    procedure Change;
      override;
    function GetButtonEnabled : Boolean;
      override;
    procedure KeyDown(var Key : Word; Shift : TShiftState);
      override;
    procedure KeyPress(var Key : Char);
      override;
    procedure Notification(AComponent : TComponent; Operation : TOperation);
      override;
  {.Z-}

    {protected properties}
    property AutoUpdate : Boolean
      read FAutoUpdate write FAutoUpdate;
    property DataField : string
      read GetDataField write SetDataField;
    property DataSource : TDataSource
      read GetDataSource write SetDataSource;
    property PreserveTime : Boolean
      read FPreserveTime write FPreserveTime;

  {.Z+}
    property ReadOnly : Boolean {hides ancestor's ReadOnly property}
      read GetReadOnly
      write SetReadOnly;

  public
    constructor Create(AOwner : TComponent);
      override;
    destructor Destroy;
      override;
    {$IFDEF VERSION4}
    function ExecuteAction(Action: TBasicAction): Boolean;
      override;
    function UpdateAction(Action: TBasicAction): Boolean;
      override;
    {$ENDIF}

    procedure PopupClose(Sender : TObject);
      override;
    procedure PopupOpen;
      override;
  {.Z-}

    {public properties}
    property Field : TField
      read GetField;
  end;

  TOvcDbDateEdit = class(TOvcCustomDbDateEdit)
  published
    {properties}
    {$IFDEF VERSION4}
    property Anchors;
    property Constraints;
    property DragKind;
    {$ENDIF}
    property About;
    property AllowIncDec;
    property AutoSelect;
    property AutoSize;
    property AutoUpdate;
    property BorderStyle;
    property ButtonGlyph;
    property CharCase;
    property Color;
    property Controller;
    property Ctl3D;
    property Cursor;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Epoch;
    property Font;
    property ForceCentury;
    property HideSelection;
    property LabelInfo;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupAnchor;
    property PopupColors;
    property PopupDateFormat;
    property PopupDayNameWidth;
    property PopupFont;
    property PopupHeight;
    property PopupMenu;
    property PopupOptions;
    property PopupWidth;
    property PopupWeekStarts;
    property PreserveTime;
    property ReadOnly;
    property RequiredFields;
    property ShowButton;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TodayString;
    property Visible;

    {inherited events}
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetDate;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSetDate;
    {$IFDEF Win32}
    property OnStartDrag;
    {$ENDIF Win32}
  end;


implementation

const
  DateFieldTypes : set of  TFieldType = [ftDate, ftDateTime];


{*** TOvcCustomDbDateEdit ***}

procedure TOvcCustomDbDateEdit.Change;
begin
  FDataLink.Modified;

  inherited Change;
end;

procedure TOvcCustomDbDateEdit.CMEnter(var Message : TCMEnter);
begin
  SetFocused(True);

  inherited;
end;

procedure TOvcCustomDbDateEdit.CMExit(var Message : TCMExit);
var
  WasModified : Boolean;
begin
  if PopupActive then
    Exit;

  if AutoUpdate then begin
    WasModified := Modified;
    DoExit;    {force update of date}
    try
      if WasModified then
        FDataLink.UpdateRecord;
    except
      SelectAll;
      SetFocus;
      raise;
    end;
  end;
  SetFocused(False);
end;

{$IFDEF Win32}
procedure TOvcCustomDbDateEdit.CMGetDataLink(var Message : TMessage);
begin
  Message.Result := LongInt(FDataLink);
end;
{$ENDIF Win32}

constructor TOvcCustomDbDateEdit.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  inherited ReadOnly := True;

  {$IFDEF Win32}
  ControlStyle := ControlStyle + [csReplicatable];
  {$ENDIF Win32}

  FAutoUpdate := True;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
end;

procedure TOvcCustomDbDateEdit.DataChange(Sender : TObject);
var
  P  : Integer;
  DT : TDateTime;
  S  : string[80];
begin
  if FDataLink.Field <> nil then begin
    if FAlignment <> FDataLink.Field.Alignment then begin
      FAlignment := FDataLink.Field.Alignment;
      Text := '';
    end;
    if FDataLink.Field.DataType in DateFieldTypes then begin
      if FDataLink.Field.IsNull then
        Text := ''
      else begin
        DT := FDataLink.Field.AsDateTime;
        SetDate(Trunc(DT))
      end;
    end else if FDataLink.Field.DataType = ftFloat then begin
      if FDataLink.Field.IsNull then
        Text := ''
      else begin
        DT := FDataLink.Field.AsFloat;
        SetDate(Trunc(DT))
      end;
    end else begin
      S := FDataLink.Field.ClassName;
      S[1] := '(';
      P := Pos('Field', S);
      if P > 0 then begin
        S[P] := ')';
        S[0] := Char(P);
      end else
        S := Concat(S, ')');
      Text := S;
    end;
  end else begin
    FAlignment := taLeftJustify;
    if csDesigning in ComponentState then
      Text := Name
    else
      Text := '';
  end;
end;

destructor TOvcCustomDbDateEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;

  FCanvas.Free;
  FCanvas := nil;

  inherited Destroy;
end;

procedure TOvcCustomDbDateEdit.EditingChange(Sender : TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;

  FButton.Enabled := GetButtonEnabled;
end;

function TOvcCustomDbDateEdit.GetButtonEnabled : Boolean;
begin
  Result := (FDataLink <> nil) and (FDataLink.DataSource <> nil) and
    (FDataLink.Editing or FDataLink.DataSource.AutoEdit) or
    (csDesigning in ComponentState);
end;

function TOvcCustomDbDateEdit.GetDataField : string;
begin
  Result := FDataLink.FieldName;
end;

function TOvcCustomDbDateEdit.GetDataSource : TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function TOvcCustomDbDateEdit.GetField : TField;
begin
  Result := FDataLink.Field;
end;

function TOvcCustomDbDateEdit.GetReadOnly : Boolean;
begin
  Result := FDataLink.ReadOnly;
  if FDataLink.Field <> nil then
    if not ((FDataLink.Field.DataType in DateFieldTypes) or
            (FDataLink.Field.DataType= ftFloat)) then
      Result := True;
end;

function TOvcCustomDbDateEdit.GetTextMargins : TPoint;
var
  DC         : HDC;
  SaveFont   : HFont;
  I          : Integer;
  SysMetrics : TTextMetric;
  Metrics    : TTextMetric;
begin
  if NewStyleControls then begin
    if BorderStyle = bsNone then
      I := 0
    else if Ctl3D then
      I := 1
    else
      I := 2;
    {$IFDEF Win32}
    Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
    {$ELSE}
    Result.X := 2;
    {$ENDIF Win32}
    Result.Y := I;
  end else begin
    if BorderStyle = bsNone then
      I := 0
    else begin
      DC := GetDC(0);
      GetTextMetrics(DC, SysMetrics);
      SaveFont := SelectObject(DC, Font.Handle);
      GetTextMetrics(DC, Metrics);
      SelectObject(DC, SaveFont);
      ReleaseDC(0, DC);
      I := SysMetrics.tmHeight;
      if I > Metrics.tmHeight then
        I := Metrics.tmHeight;
      I := I div 4;
    end;
    Result.X := I;
    Result.Y := I;
  end;
end;

procedure TOvcCustomDbDateEdit.KeyDown(var Key : Word; Shift : TShiftState);
begin
  inherited KeyDown(Key, Shift);

  {start edit mdoe if cutting or pasting}
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TOvcCustomDbDateEdit.KeyPress(var Key : Char);
begin
  if AllowIncDec and (Key in ['+', '-']) then
    FDataLink.Edit;

  inherited KeyPress(Key);

  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
     not FDataLink.Field.IsValidChar(Key) then begin
    MessageBeep(0);
    Key := #0;
  end;

  case Key of
    ^H, ^V, ^X, #32..#255 :
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

procedure TOvcCustomDbDateEdit.Notification(AComponent : TComponent; Operation : TOperation);
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
    DataSource := nil;
end;

procedure TOvcCustomDbDateEdit.PopupClose(Sender : TObject);
begin
  inherited PopupClose(Sender);

  {allow control to see focus change that was blocked when popup became active}
  if not Focused then
    Perform(CM_EXIT, 0, 0);
end;

procedure TOvcCustomDbDateEdit.PopupOpen;
begin
  inherited PopupOpen;

  {enter edit mode}
  FDataLink.Edit;
end;

procedure TOvcCustomDbDateEdit.SetDataField(const Value : string);
begin
  try
    FDataLink.FieldName := Value;
  except
    FDataLink.FieldName := '';
    raise;
  end;
end;

procedure TOvcCustomDbDateEdit.SetDataSource(Value : TDataSource);
begin
  FDataLink.DataSource := Value;
  {$IFDEF Win32}
  if Value <> nil then
    Value.FreeNotification(Self);
  {$ENDIF Win32}
end;

procedure TOvcCustomDbDateEdit.SetFocused(Value : Boolean);
begin
  if FFocused <> Value then begin
    FFocused := Value;
    if (FAlignment <> taLeftJustify) then
      Invalidate;
    FDataLink.Reset;
  end;
end;

procedure TOvcCustomDbDateEdit.SetReadOnly(Value : Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

procedure TOvcCustomDbDateEdit.UpdateData(Sender : TObject);
var
  DT : TDateTime;
begin
  if (FDataLink.Field.DataType in DateFieldTypes) or
     (FDataLink.Field.DataType = ftFloat) then begin
    if FDataLink.Field.DataType = ftFloat then
      DT := FDataLink.Field.AsFloat
    else
      DT := FDataLink.Field.AsDateTime;
    if Text = '' then begin {save just the time portion}
      if FPreserveTime and (FDataLink.Field.DataType in [ftDateTime, ftFloat])
        and (Frac(DT) <> 0) then begin
        if FDataLink.Field.DataType = ftFloat then
          FDataLink.Field.AsFloat := Frac(DT)
        else
          FDataLink.Field.AsDateTime := Frac(DT);
      end else
        FDataLink.Field.Clear;
    end else begin
      DoExit;  {validate field and translate date}
      if FDataLink.Field.DataType = ftFloat then begin
        if FPreserveTime then
          FDataLink.Field.AsFloat := FDate + Frac(DT)
        else
          FDataLink.Field.AsFloat := FDate;
      end else begin
        if FPreserveTime then
          FDataLink.Field.AsDateTime := FDate + Frac(DT)
        else
          FDataLink.Field.AsDateTime := FDate;
      end;
    end;
  end else
    FDataLink.Field.Text := Text;
end;

procedure TOvcCustomDbDateEdit.WMCut(var Message : TMessage);
begin
  FDataLink.Edit;

  inherited;
end;

procedure TOvcCustomDbDateEdit.WMPaint(var Message : TWMPaint);
var
  Left    : Integer;
  Margins : TPoint;
  R       : TRect;
  DC      : HDC;
  PS      : TPaintStruct;
  S       : string;
begin
  {$IFDEF Win32}
  if ((FAlignment = taLeftJustify) or FFocused) and not (csPaintCopy in ControlState) then begin
  {$ELSE}
  if ((FAlignment = taLeftJustify) or FFocused) then begin
  {$ENDIF Win32}
    inherited;
    Exit;
  end;

  {draw right and center justify manually unless the edit has the focus}
  if FCanvas = nil then begin
    FCanvas := TControlCanvas.Create;
    FCanvas.Control := Self;
  end;
  DC := Message.DC;
  if DC = 0 then
    DC := BeginPaint(Handle, PS);
  FCanvas.Handle := DC;
  try
    FCanvas.Font := Font;
    with FCanvas do begin
      R := ClientRect;
      if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then begin
        Brush.Color := clWindowFrame;
        FrameRect(R);
        InflateRect(R, -1, -1);
      end;
      Brush.Color := Color;
      {$IFDEF Win32}
      if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then begin
        S := FDataLink.Field.DisplayText;
      end else
      {$ENDIF Win32}
        S := Text;
      if PasswordChar <> #0 then FillChar(S[1], Length(S), PasswordChar);
      Margins := GetTextMargins;
      case FAlignment of
        taLeftJustify  : Left := Margins.X;
        taRightJustify : Left := ClientWidth - TextWidth(S) - Margins.X - 2 - GetButtonWidth;
      else
        Left := (ClientWidth - TextWidth(S)) div 2;
      end;
      TextRect(R, Left, Margins.Y, S);
    end;
  finally
    FCanvas.Handle := 0;
    if Message.DC = 0 then
      EndPaint(Handle, PS);
  end;
end;

procedure TOvcCustomDbDateEdit.WMPaste(var Message : TMessage);
begin
  FDataLink.Edit;

  inherited;
end;

{$IFDEF VERSION4}
function TOvcCustomDbDateEdit.ExecuteAction(Action : TBasicAction) : Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TOvcCustomDbDateEdit.UpdateAction(Action : TBasicAction) : Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;
{$ENDIF}

end.